home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ape-ad1a / cdxvbfps.cls < prev    next >
Text File  |  1998-11-07  |  995b  |  42 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CDXVBFPS"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Public FPS As Long
  11. Private freqPerformance, firstTick, freqAdjust As Long
  12.  
  13. Public Sub GetFPS()
  14.       Dim diffTick As Long
  15.       Static FpsTime, lastTick As Long
  16.       Static FramesRendered As Long
  17.       
  18.       Call GetTick
  19.       
  20.       diffTick = firstTick - lastTick
  21.       lastTick = firstTick
  22.       
  23.       FpsTime = FpsTime + diffTick
  24.       FramesRendered = FramesRendered + 1
  25.       
  26.       If FpsTime > ((1000 * freqPerformance) / freqAdjust) Then
  27.             FPS = FramesRendered
  28.             FramesRendered = 0
  29.             FpsTime = 0
  30.       End If
  31. End Sub
  32.  
  33. Private Sub GetTick()
  34.       firstTick = timeGetTime()
  35.       freqAdjust = 1
  36.       freqPerformance = 1
  37. End Sub
  38.  
  39. Public Function ReturnFPS() As Long
  40.       ReturnFPS = FPS
  41. End Function
  42.